home *** CD-ROM | disk | FTP | other *** search
/ PD ROM 1 / PD ROM Volume I - Macintosh Software from BMUG (1988).iso / Programming / Complete Applications / 4D Programming / External Procedures / DateFolder / XDate.pit / DateChange.p < prev    next >
Encoding:
Text File  |  1987-09-25  |  2.8 KB  |  107 lines
  1. Program DateChange;
  2.  
  3. {$R-}
  4. {$U-}
  5. {$D 4DEX}
  6.  
  7. USES Memtypes, Quickdraw, OSIntf, Toolintf, PackIntf;
  8.  
  9.  
  10. Procedure my4DEX(var Datein:str255; var Numin:Longint);
  11.  
  12.     var
  13.         Year1, Year2, Year3, Leap, Month, Days, Final, Count, Years, Worknum: Longint;
  14.         Sdays, Smonth, Syears: str255;
  15.         Months: Array[1..12] of Longint;
  16.  
  17.     Begin
  18.         Months[1]:=31;
  19.         Months[2]:=28;
  20.         Months[3]:=31;
  21.         Months[4]:=30;
  22.         Months[5]:=31;
  23.         Months[6]:=30;
  24.         Months[7]:=31;
  25.         Months[8]:=31;
  26.         Months[9]:=30;
  27.         Months[10]:=31;
  28.         Months[11]:=30;
  29.         Months[12]:=31;
  30.  
  31.  
  32.         If (Numin=0) then
  33.  
  34. {here we convert string to number and pass back in Datein}
  35.  
  36.         begin
  37.             StringToNum(Copy(Datein, 4, 2), Days);
  38.             StringToNum(Copy(Datein, 1, 2), Month);
  39.             StringToNum(Copy(Datein, 7, 1), Year1);
  40.             StringToNum(Copy(Datein, 8, 1), Year2);
  41.             StringToNum(Copy(Datein, 9, 2), Year3);
  42.     
  43.             Leap:=Trunc(Year3/4);
  44.             Final:=(Year1*365000)+(Year1*250)+(Year2*36500)+(Year2*25)+(Year3*365)+Leap+Days;
  45.     
  46.  
  47.             If(((Leap*4)=Year3) And (Month<3)) then
  48.                 Final:=Final-1;
  49.     
  50.             Count:=1;
  51.             While(Count<Month) do
  52.             begin
  53.                 Final:=Final+Months[Count];
  54.                 Count:=Count+1;
  55.             end;
  56.             Numin:=Final;
  57.         end
  58.   
  59.         else
  60.   
  61. {Now we convert Numin to Datein}
  62.   
  63.         begin
  64.             Worknum:=Numin-1;
  65.             Year1:=Trunc(Worknum/365000);
  66.             Worknum:=Worknum-(Year1*365000)-(Year1*250);
  67.             Year2:=Trunc(Worknum/36500);
  68.             Worknum:=Worknum-(Year2*36500)-(Year2*25);
  69.             Year3:=Trunc(Worknum/365);
  70.             Worknum:=Worknum-(Year3*365);
  71.             Leap:=Trunc(Year3/4);
  72.             Worknum:=Worknum-Leap+1;
  73.             Month:=1;
  74.             While(Months[Month]<Worknum) do
  75.             begin
  76.                 Worknum:=Worknum-Months[Month];
  77.                 Month:=Month+1;
  78.             end;
  79.             Days:=Worknum;
  80.             Years:=Year3+(Year2*100)+(Year1*1000);
  81.  
  82.  
  83.             If (((Year3/4)=Trunc(Year3/4)) and (Month<3)) then
  84.                 Days:=Days+1;
  85.  
  86.             If ((Month=1) and (Days=0)) then
  87.             begin
  88.                 Days:=31;
  89.                 Month:=12;
  90.                 Years:=Years-1;
  91.             end;
  92.     
  93.             NumToString(Days, Sdays);
  94.             NumToString(Month, Smonth);
  95.             NumToString(Years, Syears);
  96.             If(Length(Sdays)<2) then
  97.                 Sdays:=Concat('0', Sdays);
  98.             If(Length(Smonth)<2) then
  99.                 Smonth:=Concat('0', Smonth);
  100.             While(Length(Syears)<4) do
  101.                 Syears:=Concat('0', Syears);
  102.             Datein:=Concat(Smonth, '/', Sdays, '/', Syears);    
  103.         End
  104.     End;
  105.  
  106. Begin
  107. End.